home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / utility / 533 / kwic / qucksrt2.pas < prev    next >
Pascal/Delphi Source File  |  1991-04-25  |  3KB  |  83 lines
  1.  
  2. {                   *** Sort the array 'Arr' in situ ***           }
  3. PROCEDURE QuickSort(VAR Arr:T141;   UB:T158);  {T158 is integer (bounds)}
  4.   {Sorts 10000 integers in about 5.6 s.}
  5.  
  6.     PROCEDURE Swap(VAR x,y:T383);  {T383 is string[11]. Key words.}
  7.       VAR
  8.         Temp : T383;
  9.       BEGIN
  10.         Temp := x;
  11.         x    := y;
  12.         y    := Temp;
  13.       END{swap};
  14.       
  15.     PROCEDURE Swap2(VAR c,d:integer);
  16.       VAR Temp:integer;
  17.       BEGIN{swap2}
  18.         Temp := c;
  19.         c := d;
  20.         d := Temp;
  21.       END{swap2};  
  22.       
  23.     PROCEDURE SubSort(L,R:T158);
  24.       VAR
  25.         i,j : T158;
  26.         
  27.       PROCEDURE PartitionArray(L,R:T158);
  28.         {Bad name, this actually sorts. Establish a 'pivot point' with
  29.         half the items on the left, half on the right. Start at the left
  30.         and go utill an item greater than the pivot point item is found.
  31.         Stop and do the complementary thing on the right hand side.  
  32.         Exchange these two items.
  33.         Continue this process until the two pointers meet.}
  34.         VAR
  35.           PivotValue : T383;  {string[11]}
  36.         BEGIN
  37.           i := L;
  38.           j := R;
  39.           PivotValue := Arr[(L + R) DIV 2];
  40.           REPEAT
  41.             WHILE Arr[i] < PivotValue DO
  42.               i := i + 1;
  43.             WHILE Arr[j] > PivotValue DO
  44.               j := j - 1;
  45.             IF i < j 
  46.               THEN
  47.                 BEGIN
  48.                   Swap(Arr[i],         Arr[j]);
  49.                   Swap2(TheLine[i],  TheLine[j]);
  50.                   i := i + 1;
  51.                   j := j - 1;
  52.                 END;
  53.           UNTIL i >= j;
  54.         END {partitionarray};                  
  55.         
  56.       BEGIN{subsort}
  57.         IF L < R 
  58.           THEN
  59.             IF L + 1 = R
  60.               THEN
  61.                  IF Arr[L] > Arr[R]
  62.                    THEN 
  63.                      BEGIN
  64.                        Swap(Arr[L],         Arr[R]);
  65.                        Swap2(TheLine[L],  TheLine[R]);
  66.                      END  
  67.                    ELSE {  }
  68.               ELSE {L + 1 <> R} 
  69.                 IF L + 1 < R
  70.                   THEN {segment has 3 or more components}
  71.                     BEGIN
  72.                       PartitionArray(L,R);
  73.                       SubSort(L,J);  (* recursion *)
  74.                       SubSort(I,R);
  75.                     END
  76.                   ELSE {L + 1 = R}
  77.           ELSE {L >= R};   
  78.       END{subsort};                   
  79.       
  80.   BEGIN {quicksort}
  81.     SubSort(1,UB);           
  82.   END{quicksort};
  83.